home *** CD-ROM | disk | FTP | other *** search
/ Compute! Gazette 1986 March / 1986-03.d64 / coord demos (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1986-01-01  |  4.8 KB  |  112 lines
  1. 5 rem *** load ml from disk or tape ***
  2. 10 d=8:e=65:a=e:f=147:e$=chr$(f):p=57812:l=62631:s=62957:ifpeek(687)=54then25
  3. 15 pokef,0:syspchr$(e)+" coord.obj",d,1:sysl:e=e+1:ife<a+2then15
  4. 20 rem *** set coordinator variables ***
  5. 25 reset=681:clear=686:plot=707:erase=714
  6. 30 setflag=767:init=1020:mflag=0:rem mflag=1 turns on multicolor, 0 is off
  7. 35 rem *** set color registers ***
  8. 40 fg=646:bo=53280:bg=bo+1
  9. 45 ifmfthenm2=bo+2:m3=bo+3:pokem2,6:pokem3,4:rem set multicolor regs. (m1=fg)
  10. 50 rem *** set hi-res variables ***
  11. 55 bank=1:scnoffset=1:coloffset=7
  12. 60 rem *** create display (note changes from magazine listing) ***
  13. 65 pokebo,0:pokebg,0:pokefg,1:printe$:printtab(90)" choose demonstration "
  14. 70 pokefg,6:print"  note: this menu is provided for disk  subscribers only ";
  15. 75 print"and results in changes":printtab(7)"to the published listing":pokefg,1
  16. 80 print:print:print"> press  d [146] to run the demo and return"
  17. 85 printtab(13)"to this menu":print"> press  m [146] to run the mountain demo -"
  18. 90 print"  which includes the save/load routine"
  19. 95 print:print"> press any other key to end the program"
  20. 100 poke198,0
  21. 105 getnr$:on-(nr$="")-2*(nr$="d")-3*(nr$="m")goto105,115,120
  22. 110 goto175
  23. 115 gosub185:goto365
  24. 120 gosub185:goto465
  25. 150 rem *** restore default display ***
  26. 155 ifpeek(198)=0then155:rem wait for a keypress to end program
  27. 160 poke198,0:rem tidy up keypress if it comes
  28. 165 pokefg,peek(bg)+1:rem ensure text color is different from background
  29. 170 poke53270,200:poke56576,151:poke53265,27:poke53272,21:ifsfthenreturn
  30. 175 end
  31. 180 rem *** set up hi-res ***
  32. 185 poke56576,(peek(56576)and252)or(3-bank):rem set bank
  33. 190 poke53265,peek(53265)or32:rem turn on bitmap
  34. 195 ifmfthenpoke53270,peek(53270)or16:rem set multicolor if desired
  35. 200 poke53272,(coloffset*16+scnoffset*8):rem position hi-res and color memories
  36. 205 return
  37. 210 rem *** screen save/load subroutine ***
  38. 215 rem note: is dependent on variables from main program
  39. 220 d=8:e=49:ok=1:b(1)=ba*64+sc*32:t(1)=b(1)+32:b(2)=ba*64+co*4:t(2)=b(2)+4
  40. 225 b(3)=208:t(3)=b(3)+1:b(4)=216:t(4)=b(4)+4:sf=1:gosub165:sf=0
  41. 230 printe$:print
  42. 235 printtab(7)"** save or load screen **":print:input"  screen name";sn$
  43. 240 gv=len(sn$):on-(gv<1orgv>15)goto230:print
  44. 245 print"> for save - press s[146]":print:print"> for load - press l[146]"
  45. 250 getl$:ifl$=""orl$<>"s"andl$<>"l"then250
  46. 255 print:print:print" results[146] - name is "sn$:printtab(11)"and this is a ";
  47. 260 ifl$="s"thenprint"save":goto270
  48. 265 print"load"
  49. 270 print:print:printtab(6)">> if correct - press c[146] <<"
  50. 275 print:printtab(5)"any other key allows changes"
  51. 280 getm$:on-(m$="")-2*(m$="c")goto280,290
  52. 285 goto230
  53. 290 printe$:print" saving:"sn$:ifl$="l"thenprinte$:print" loading:"sn$:goto320
  54. 295 sysp"@:"+chr$(e)+sn$,d,1:poke193,0:poke194,b(ok)
  55. 300 poke174,0:poke175,t(ok):syss
  56. 305 e=e+1:ok=ok+1:ifok<4then295
  57. 310 ifmfandok=4then295
  58. 315 goto340
  59. 320 pokef,0:syspchr$(e)+sn$,d,1:sysl
  60. 325 e=e+1:ife<52then320
  61. 330 ifmfande=52then320
  62. 335 ifd<>8then355
  63. 340 qa=0:open15,8,15:input#15,qa,qb$,qc,qd:close15:ifqa<20then355
  64. 345 printe$:print" disk error!":print:printtab(13)" disk status [146]"
  65. 350 print:printtab(7)qa;qb$;qc;qd:end
  66. 355 gosub185:return
  67. 360 rem *** demo ***
  68. 365 pokebo,0:pokebg,0:pokefg,1:y=100:x=160:sysclear:o=x:n=y:rem set screen
  69. 370 forr=7to87step8:pokebg,-(r/8>7)*r/7:pokefg,r/7-8*(r/8>7):rem radius & color
  70. 375 fora=0to(NULL)/2step2/r:x=r*sin(a)+o:y=r*cos(a)+n:sysplot:rem sweep 90 degrees
  71. 380 x=-x+2*o:sysplot:y=-y+2*n:sysplot:x=-x+2*o:sysplot:rem but plot 4 quadrants
  72. 385 nexta
  73. 390 nextr
  74. 395 ifmfthenpokem3,5:rem bit pattern 1,1 plots green if multicolor
  75. 400 y=100:forx=0to319:pokebg,x/8:pokefg,x/8+1:sysplot:next:remdraw colored line
  76. 405 pokebg,0:pokefg,10:forx=0to319:syserase:next:rem erase line with lt. red
  77. 410 y=95:pokefg,1:forx=0to319:sysplot:ifpeek(setflag)thensysplot:goto420
  78. 415 syserase:rem 395-405 move a white point but don't erase
  79. 420 next
  80. 425 deffnmc(a)=int(a)-(int(a/2)<>int(a)/2):syscl:r=95:poke646,2
  81. 430 fora=0to319step2.26:x=fnmc(a):y=r+80*sin(a/20):syser:x=x+1:syspl:next
  82. 435 fora=0to319step2.26:x=fnmc(a):y=r+60*sin(a/25):syspl:x=x+1:syser:next
  83. 440 fora=0to319step2.26:x=fnmc(a):y=r+40*sin(a/30):syspl:x=x+1:syspl:next
  84. 445 fora=0to319step2.26:x=fnmc(a):y=r+60*sin(a/25):syser:x=x+1:syser:next
  85. 450 sf=1:gosub165:sf=0:goto65
  86. 460 rem *** mountain demo ***
  87. 465 poke198,0:pokefg,11:pokebg,0:pokebo,0:x=-1:y=-1:syscl
  88. 466 j%=rnd(0)*10:j%=-j%*(j%>3andj%<7):on-(j%=0)goto466:j%=j%-4:c=2^j%
  89. 467 j=35-(c=1)*17:v=2:a=-20:j%=rnd(0)*5:b=-j%*20:z=1:e=0
  90. 468 h=int((320-b)/(j-10)):dim g(h+1):g(0)=b:deffnp(m)=(-1)^int(rnd(0)*3)
  91. 469 deffnm(r)=(n+(n<80)*n*.3)/133+(n>180)*(n-180)/79
  92. 470 forq=1toh:g(q)=g(q-1)+j+rnd(0)*10:ifg(q)>=320theno=q:q=h
  93. 471 next:dimr(o+1,2),t(o+1,2),u(o+1),b(o+1):j%=rnd(0)*5:m=10+(j%+4-c)*5
  94. 472 j%=-(c>1):r(0,0)=g(0):t(0,0)=rnd(0)*3.3-a:u(0)=1
  95. 473 forq=1too:r(q,0)=g(q):u(q)=u(q-1)*(1+2*(q/c=int(q/c)))
  96. 474 t(q,0)=t(q-1,0)+((rnd(0)*3.3+2)*u(q)):n=r(q,0)
  97. 475 t(q,0)=t(q,0)-(n<=160)*n/80+(n>160)*n/120:gosub483:b(q)=-(k>i):next:e=1
  98. 476 v=v+.004:m=m+v^1.0001:r(0,1)=r(0,0)+.9+rnd(0)*.5*fnp(m)
  99. 477 t(0,1)=t(0,0)+rnd(0)*2:forq=1too
  100. 478 r(q,1)=r(q,0)+(1+(b(q)=0andb(q+1)=1)*j%)*(rnd(1)*(2+c/2)+.3)
  101. 479 n=r(q,1):t(q,1)=t(q-1,1)+t(q,0)-t(q-1,0)+rnd(0)*2
  102. 480 t(q,1)=t(q,1)-(b(q)=1)*rnd(1)*m*fnm(r)/20:ifr(q,1)>r(q-1,1)then482
  103. 481 r(q,1)=r(q-1,1)+.01:ifq>=3thent(q,1)=t(q-1+(c=1)*2,1)-6
  104. 482 gosub483:r(q,0)=r(q,1):t(q,0)=t(q,1):next:r(0,0)=r(0,1):t(0,0)=t(0,1):goto476
  105. 483 h=r(q-1,e):i=t(q-1,e):j=r(q,e):k=t(q,e)
  106. 484 w=(j-h)*(1.3+rnd(0)*.9-(k<i)*1.7*(rnd(0)+1))/sqr((j-h)^2+(k-i)^2)
  107. 485 ifk>170andj>0andj<320thenj=r(q,0):k=t(q,0):z=0
  108. 486 forx=htojstepw:y=i+(k-i)*(x-h)/(j-h):syspl:next:ifzthenreturn
  109. 487 fory=0to199step8:forx=0to319step8:u=fnp(m)*rnd(0)*24
  110. 488 pokefg,7+2*(y>36+u)-9*(y>76+u)+13*(y>114+u):syser:ifpeek(se)thensyspl
  111. 489 next:next:poke49,peek(47):poke50,peek(48):gosub220:goto155
  112.